// (c) Microsoft Corporation 2005-2008.

#light

namespace Microsoft.FSharp.Text.Lexing 

    open Microsoft.FSharp.Core
    open Microsoft.FSharp.Collections
    open System.Collections.Generic

    type Position = 
        { pos_fname : string;
          pos_lnum : int;
          pos_bol : int;
          pos_cnum : int; }
        member x.FileName = x.pos_fname
        member x.Line = x.pos_lnum
        member x.Char = x.pos_cnum
        member x.AbsoluteOffset = x.pos_cnum
        member x.StartOfLine = x.pos_bol
        member x.StartOfLineAbsoluteOffset = x.pos_bol
        member x.Column = x.pos_cnum - x.pos_bol
        member pos.NextLine = {pos with pos_lnum = pos.Line+1; pos_bol = pos.AbsoluteOffset }
        member pos.EndOfToken(n) = {pos with pos_cnum=pos.pos_cnum + n }
        member pos.AsNewLinePos() = pos.NextLine
        static member Empty = {pos_fname=""; pos_lnum= 0; pos_bol= 0; pos_cnum=0 }
        static member FirstLine(filename) = {pos_fname=filename; pos_lnum= 1; pos_bol= 0; pos_cnum=0 }

    [<Sealed>]
    type LexBuffer<'char>(refill) as this = 
        let context = new Dictionary<string,obj>(1) in 
        let extendBuffer = (fun () -> refill this)
        let mutable buffer=Array.zero_create 4096;
        /// number of valid charactes beyond bufferScanStart 
        let mutable bufferMaxScanLength=0;
        /// count into the buffer when scanning 
        let mutable bufferScanStart=0;
        /// number of characters scanned so far 
        let mutable bufferScanLength=0;
        /// length of the scan at the last accepting state 
        let mutable lexemeLength=0;
        /// action related to the last accepting state 
        let mutable bufferAcceptAction=0;
        let mutable eof = false;
        let mutable startPos = Position.Empty ;
        let mutable endPos = Position.Empty

        // let from_text_reader (tr:System.IO.TextReader) = createNewLexbuffer (fun chars -> ) 
              
        let getLexemeChar () n =  buffer.[n+bufferScanStart]
        let getLexeme () = buffer.[bufferScanStart..bufferScanStart+lexemeLength-1]
        let getLexemeLength () = lexemeLength
          
        // Throw away all the input besides the lexeme 
              
        let discardInput () = 
            let keep = Array.sub buffer bufferScanStart bufferScanLength
            let nkeep = keep.Length 
            Array.blit keep 0 buffer 0 nkeep;
            bufferScanStart <- 0;
            bufferMaxScanLength <- nkeep
                 
              
        member lexbuf.EndOfScan () : int =
            // Printf.eprintf "endOfScan, lexBuffer.lexemeLength = %d\n" lexBuffer.lexemeLength;
            if bufferAcceptAction < 0 then 
                failwith "unrecognized input"

            //  Printf.printf "endOfScan %d state %d on unconsumed input '%c' (%d)\n" a s (Char.chr inp) inp;
            //   Printf.eprintf "accept, lexeme = %s\n" (lexeme lexBuffer); 
            lexbuf.StartPos <- endPos;
            lexbuf.EndPos <- endPos.EndOfToken(lexbuf.LexemeLength);
            bufferAcceptAction

        member lexbuf.StartPos
           with get() = startPos
           and  set(b) =  startPos <- b
           
        member lexbuf.EndPos 
           with get() = endPos
           and  set(b) =  endPos <- b

        member lexbuf.Lexeme         = Array.sub buffer bufferScanStart lexemeLength
        member lexbuf.LexemeChar(n)  = buffer.[n+bufferScanStart]
        
        member lexbuf.BufferLocalStore = (context :> IDictionary<_,_>)
        member internal lexbuf.LexemeLength        with get() : int = lexemeLength    and set v = lexemeLength <- v
        member internal lexbuf.Buffer              with get() : 'char[] = buffer              and set v = buffer <- v
        member internal lexbuf.BufferMaxScanLength with get() = bufferMaxScanLength and set v = bufferMaxScanLength <- v
        member internal lexbuf.BufferScanLength    with get() = bufferScanLength    and set v = bufferScanLength <- v
        member internal lexbuf.BufferScanStart     with get() : int = bufferScanStart     and set v = bufferScanStart <- v
        member internal lexbuf.BufferAcceptAction  with get() = bufferAcceptAction  and set v = bufferAcceptAction <- v
        member internal lexbuf.ExtendBuffer = extendBuffer

        static member LexemeString(lexbuf:LexBuffer<char>) = 
            new System.String(lexbuf.Buffer,lexbuf.BufferScanStart,lexbuf.LexemeLength)

        member lexbuf.IsPastEndOfStream 
           with get() = eof
           and  set(b) =  eof <- b

        member lexbuf.DiscardInput() = discardInput ()

        member x.BufferScanPos = bufferScanStart + bufferScanLength


        member lexbuf.EnsureBufferSize n = 
            if lexbuf.BufferScanPos + n >= buffer.Length then 
                let repl = Array.zero_create (lexbuf.BufferScanPos + n) 
                Array.blit buffer bufferScanStart repl bufferScanStart bufferScanLength;
                buffer <- repl

        // A full type signature is required on this method because it is used at more specific types within its own scope
        static member FromFunction (f : 'char[] -> int -> int) : LexBuffer<'char> = 
            let extension= Array.zero_create 4096
            new LexBuffer<_>((fun lexBuffer -> 
                let n = f extension extension.Length 
                lexBuffer.EnsureBufferSize n;
                Array.blit extension 0 lexBuffer.Buffer lexBuffer.BufferScanPos n;
                lexBuffer.BufferMaxScanLength <- lexBuffer.BufferScanLength + n))
              
        // A full type signature is required on this method because it is used at more specific types within its own scope
        static member FromArray (s: 'char[]) : LexBuffer<'char> = 
            let lexBuffer = new LexBuffer<_>((fun lexBuffer -> ()))
            let buffer = Array.copy s 
            lexBuffer.Buffer <- buffer;
            lexBuffer.BufferMaxScanLength <- buffer.Length;
            lexBuffer
              

        static member FromBytes    (arr) = LexBuffer<byte>.FromArray(arr)
        static member FromChars    (arr) = LexBuffer<char>.FromArray(arr) 
        static member FromByteFunction (f) = LexBuffer<byte>.FromFunction(f) 
        static member FromCharFunction (f) = LexBuffer<char>.FromFunction(f) 

        static member FromTextReader (tr:System.IO.TextReader)  : LexBuffer<char> = 
           LexBuffer.FromFunction (fun buf len ->tr.Read(buf,0,len))

        static member FromBinaryReader (tr:System.IO.BinaryReader)  : LexBuffer<byte> = 
           LexBuffer.FromFunction (fun (buf: byte[]) (len:int) ->tr.Read(buf,0,len))


    [<Sealed>]
    type AsciiTables(trans: uint16[] array, accept: uint16[]) =
            
        /// Interpret tables for an ascii lexer generated by fslex. 
        member tables.Interpret(initialState,lexBuffer : LexBuffer<byte>) = 
        
            let rec scanUntilSentinel s =
                let sentinel = 255 * 256 + 255 
                // Return an endOfScan after consuming the input 
                let a = int accept.[s] 
                if a <> sentinel then 
                    lexBuffer.LexemeLength <- lexBuffer.BufferScanLength;
                    lexBuffer.BufferAcceptAction <- a;
                
                if lexBuffer.BufferScanLength = lexBuffer.BufferMaxScanLength then 
                    lexBuffer.DiscardInput();
                    lexBuffer.ExtendBuffer ();
                  // end of file occurs if we couldn't extend the buffer 
                    if lexBuffer.BufferScanLength = lexBuffer.BufferMaxScanLength then  
                        let snew = int trans.[s].[256] // == EOF 
                        if snew = sentinel then 
                            lexBuffer.EndOfScan()
                        else 
                            if lexBuffer.IsPastEndOfStream then failwith "End of file on lexing stream";
                            lexBuffer.IsPastEndOfStream <- true;
                            // Printf.printf "state %d --> %d on eof\n" s snew;
                            scanUntilSentinel snew 
                    else 
                        scanUntilSentinel s 
                else
                    // read a character - end the scan if there are no further transitions 
                    let inp = int(lexBuffer.Buffer.[lexBuffer.BufferScanPos])
                    let snew = int trans.[s].[inp] 
                    if snew = sentinel then 
                        lexBuffer.EndOfScan()
                    else 
                        lexBuffer.BufferScanLength <- lexBuffer.BufferScanLength + 1;
                        // Printf.printf "state %d --> %d on '%c' (%d)\n" s snew (Char.chr inp) inp;
                        scanUntilSentinel snew 
              
            lexBuffer.BufferScanStart <- lexBuffer.BufferScanStart + lexBuffer.LexemeLength;
            lexBuffer.BufferMaxScanLength <- lexBuffer.BufferMaxScanLength - lexBuffer.LexemeLength;
            lexBuffer.BufferScanLength <- 0;
            lexBuffer.LexemeLength <- 0;
            lexBuffer.BufferAcceptAction <- -1;
            scanUntilSentinel initialState

        static member Create(trans,accept) = new AsciiTables(trans,accept)

    [<Sealed>]
    type UnicodeTables(trans: uint16[] array, accept: uint16[]) = 
        // Each row for the Unicode table has format 
        //      128 entries for ASCII characters
        //      A variable number of 2*UInt16 entries for SpecificUnicodeChars 
        //      30 entries, one for each UnicodeCategory
        //      1 entry for EOF

        member tables.Interpret(initialState,lexBuffer : LexBuffer<char>) = 
            let sentinel = 255 * 256 + 255 
            let numUnicodeCategories = 30 
            let numLowUnicodeChars = 128 
            let numSpecificUnicodeChars = (trans.[0].Length - 1 - numLowUnicodeChars - numUnicodeCategories)/2
            let eofPos    = numLowUnicodeChars + 2*numSpecificUnicodeChars + numUnicodeCategories 

            let rec scanUntilSentinel s =
                // Return an endOfScan after consuming the input 
                let a = int accept.[s] 
                if a <> sentinel then 
                    lexBuffer.LexemeLength <- lexBuffer.BufferScanLength;
                    lexBuffer.BufferAcceptAction <- a;
                
                if lexBuffer.BufferScanLength = lexBuffer.BufferMaxScanLength then 
                    lexBuffer.DiscardInput();
                    lexBuffer.ExtendBuffer ();
                  // end of file occurs if we couldn't extend the buffer 
                    if lexBuffer.BufferScanLength = lexBuffer.BufferMaxScanLength then  
                        let snew = int trans.[s].[eofPos] // == EOF 
                        if snew = sentinel then 
                            lexBuffer.EndOfScan()
                        else 
                            if lexBuffer.IsPastEndOfStream then failwith "End of file on lexing stream";
                            lexBuffer.IsPastEndOfStream <- true;
                            // Printf.printf "state %d --> %d on eof\n" s snew;
                            scanUntilSentinel snew 
                    else 
                        scanUntilSentinel s 
                else
                    // read a character - end the scan if there are no further transitions 
                    let inp = lexBuffer.Buffer.[lexBuffer.BufferScanPos]
                    let inpAsInt = int inp
                    
                    // Find the new state
                    let snew = 
                        // Is it a fast ASCII character?
                        if inpAsInt < numLowUnicodeChars then 
                            int trans.[s].[inpAsInt]
                        else 
                            // Search for a specific unicode character
                            let baseForSpecificUnicodeChars = numLowUnicodeChars
                            let rec loop i = 
                                if i >= numSpecificUnicodeChars then 
                                    // OK, if we failed then read the 'others' entry in the alphabet,
                                    // which covers all Unicode characters not covered in other
                                    // ways
                                    let baseForUnicodeCategories = numLowUnicodeChars+numSpecificUnicodeChars*2
                                    let unicodeCategory = System.Char.GetUnicodeCategory(inp)
                                    //System.Console.WriteLine("inp = {0}, unicodeCategory = {1}", [| box inp; box unicodeCategory |]);
                                    int trans.[s].[baseForUnicodeCategories + int32 unicodeCategory]
                                else 
                                    // This is the specific unicode character
                                    let c = char (int trans.[s].[baseForSpecificUnicodeChars+i*2])
                                    //System.Console.WriteLine("c = {0}, inp = {1}, i = {2}", [| box c; box inp; box i |]);
                                    // OK, have we found the entry for a specific unicode character?
                                    if c = inp 
                                    then int trans.[s].[baseForSpecificUnicodeChars+i*2+1]
                                    else loop(i+1)
                            
                            loop 0

                    if snew = sentinel then 
                        lexBuffer.EndOfScan()
                    else 
                        lexBuffer.BufferScanLength <- lexBuffer.BufferScanLength + 1;
                        // Printf.printf "state %d --> %d on '%c' (%d)\n" s snew (char inp) inp;
                        scanUntilSentinel snew 
                  
            lexBuffer.BufferScanStart <- lexBuffer.BufferScanStart + lexBuffer.LexemeLength;
            lexBuffer.BufferMaxScanLength <- lexBuffer.BufferMaxScanLength - lexBuffer.LexemeLength;
            lexBuffer.BufferScanLength <- 0;
            lexBuffer.LexemeLength <- 0;
            lexBuffer.BufferAcceptAction <- -1;
            scanUntilSentinel initialState

        static member Create(trans,accept) = new UnicodeTables(trans,accept)
